home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / construc / INDEXBOB.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1998-01-06  |  6.5 KB  |  262 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
  2. unit IndexBob;
  3. {.$DEFINE BLOCK}
  4. interface
  5. const
  6.   IdentSet = ['A'..'Z','a'..'z',''''];
  7.  
  8. const
  9.   MaxPage = 255;
  10.  
  11. type
  12.   TNumPage = 0..MaxPage; { max number of webpages in site }
  13.   TURLPage = ShortString { assuming URL <= 255 characters };
  14.  
  15. var
  16.   WebPages: TNumPage = 0;
  17.   WebPage: Array[TNumPage] of TURLPage;
  18.   Titles: Array[TNumPage] of TURLPage;
  19.  
  20. const
  21.   MaxKeyword = 31-8;
  22.  
  23. type
  24.   TKeyword = String[MaxKeyword];
  25.   TPageSet = Set of TNumPage;
  26.  
  27.   function Pages(PageSet: TPageSet): Integer;
  28.  
  29. type
  30.   TNode = record
  31.     Keyword: TKeyword; { 32 bytes }
  32.     URLs: TPageSet;    { 32 bytes }
  33.   end {TNode};
  34.  
  35.   TTree = class
  36.     Node: TNode;
  37.     constructor Create;
  38.     destructor Destroy; override;
  39.     function FindKeywordInPages(const KeyWord: TKeyword): TPageSet;
  40.   private
  41.     Prev,Next: TTree;
  42.   end {TTree};
  43.  
  44. var
  45.   Keywords: Integer = 0;
  46.   root: TTree = nil;
  47.  
  48. type
  49. {$IFDEF BLOCK}
  50.   TIndexFile = File;
  51. {$ELSE}
  52.   TIndexFile = File of TNode;
  53. {$ENDIF}
  54.  
  55. type
  56.   TWhoAmI = (drbob42_com, intranet);
  57. var
  58.   WhoAmI: TWhoAmI;
  59.  
  60. implementation
  61. uses
  62.   DrBobSys;
  63.  
  64.   function Pages(PageSet: TPageSet): Integer;
  65.   var
  66.     B: Integer;
  67.   begin
  68.     Result := 0;
  69.     for B := MaxPage downto 0 do
  70.       if B in PageSet then Inc(Result)
  71.   end {Pages};
  72.  
  73.   constructor TTree.Create;
  74.   begin
  75.     inherited Create;
  76.     Prev := nil;
  77.     Next := nil;
  78.   {$IFDEF NULL}
  79.     FillChar(Node.Keyword,MaxKeyword+1,#0); { sparse }
  80.     Node.URLs := []
  81.   {$ENDIF}
  82.   end {Create};
  83.  
  84.   destructor TTree.Destroy;
  85.   begin
  86.     if Prev <> nil then Prev.Free;
  87.     if Next <> nil then Next.Free;
  88.     inherited Destroy
  89.   end {Destroy};
  90.  
  91.   function TTree.FindKeywordInPages(const Keyword: TKeyword): TPageSet;
  92.   var
  93.     tmp: TTree;
  94.   begin
  95.     Result := [];
  96.     tmp := root;
  97.     repeat
  98.       if tmp.Node.Keyword > Keyword then
  99.         tmp := tmp.Prev
  100.       else
  101.         if tmp.Node.Keyword < Keyword then
  102.           tmp := tmp.Next
  103.     until (tmp = nil) or (tmp.Node.Keyword = Keyword);
  104.     if tmp <> nil then
  105.       Result := tmp.Node.URLs
  106.   end {FindKeywordInPages};
  107.  
  108.  
  109.   function CreateRoot(depth: Integer): TTree;
  110.   var
  111.     r: TTree;
  112.   begin
  113.     if depth > 0 then
  114.     begin
  115.       r := TTree.Create;
  116.       r.Prev := CreateRoot(depth-1);
  117.       r.Next := CreateRoot(depth-1);
  118.       CreateRoot := r
  119.     end
  120.     else CreateRoot := nil
  121.   end {CreateRoot};
  122.  
  123.   procedure CreateLeafs(var number: Integer; root: TTree);
  124.   begin
  125.     if root.Prev <> nil then
  126.     begin
  127.       CreateLeafs(number,root.Prev);
  128.       if number > 0 then CreateLeafs(number,root.Next)
  129.     end
  130.     else
  131.     begin
  132.       root.Prev := TTree.Create;
  133.       Dec(number);
  134.       if number > 0 then
  135.       begin
  136.         root.Next := TTree.Create;
  137.         Dec(number)
  138.       end
  139.     end
  140.   end {CreateLeafs};
  141.  
  142.   procedure ReadNode(var IndexFile: TIndexFile; root: TTree);
  143.   begin
  144.     if root.Prev <> nil then ReadNode(IndexFile, root.Prev);
  145.   {$IFDEF BLOCK}
  146.     BlockRead(IndexFile,root.Node.Keyword[0],1);
  147.     BlockRead(IndexFile,root.Node.Keyword[1],Ord(root.Node.Keyword[0]));
  148.     BlockRead(IndexFile,root.Node.URLs,SizeOf(root.Node.URLs));
  149.   {$ELSE}
  150.     read(IndexFile,root.Node);
  151.   {$ENDIF}
  152.     Inc(Keywords);
  153.     if root.Next <> nil then ReadNode(IndexFile, root.Next)
  154.   end {ReadNode};
  155.  
  156. var
  157.   PageFile: Text;
  158.   Str: ShortString;
  159.   IndexFile: TIndexFile;
  160.   total,depth,i: Integer;
  161.  
  162. initialization
  163.   StartTime := timeGetTime;
  164.   Str := ParamStr(0);
  165.   if Pos('D:\INTRANET',UpperCase(STR)) = 1 then { intranet }
  166.   begin
  167.     WhoAmI := intranet;
  168.     ChDir('cgi_bin')
  169.   end
  170.   else WhoAmI := drbob42_com;
  171.   writeln('content-type: text/html');
  172.   writeln;
  173.   writeln('<HTML>');
  174.   writeln('<BODY BACKGROUND="/gif/back.gif">');
  175.   writeln('<H2>IndexBob v2.01</H2>');
  176.   writeln('IndexBob is my Website Search Engine, entirely written in Borland Delphi (the source code even compiles with Delphi 2).');
  177.   writeln('The search engine is topic of a 2-part <I>Under Construction</I> column in the Jan/Feb issues of The Delphi Magazine.');
  178.   writeln('<BR>');
  179.   writeln('The search engine now supports multiple keyword search, with (optional) <B>AND</B>, <B>OR</B> and <B>NOT</B> abilities.');
  180.   writeln('<P>');
  181.   if WhoAmI = intranet then
  182.     writeln('<FORM METHOD="POST" ACTION="/cgi_bin/indexbob.exe">')
  183.   else writeln('<FORM METHOD="POST" ACTION="/cgi-bin/indexbob.exe">');
  184.   writeln('<TABLE>');
  185.   writeln('<TR><TD><I>Search again:</I></TD>');
  186.   writeln('<TD><INPUT TYPE="TEXT" NAME="Keyword" SIZE=32></TD>');
  187.   writeln('<TD><INPUT TYPE="checkbox" NAME="Book" Value=1>Book Reviews</TD></TR>');
  188.   writeln('<TR><TD></TD><TD>');
  189.   writeln('<INPUT TYPE="SUBMIT" VALUE="Search">');
  190.   writeln('<INPUT TYPE="RESET" VALUE="Reset"></TD>');
  191.   writeln('<TD><INPUT TYPE="checkbox" NAME="Tool" Value=1>Tool Reviews</TD></TR>');
  192.   writeln('</TABLE>');
  193.   writeln('</FORM>');
  194.   writeln('Feedback is welcome in my newsgroup <A HREF="news://news.shoresoft.com/drbob.internet.tools">drbob.internet.tools</A>.');
  195.   writeln('<HR>');
  196.   assign(PageFile,'title.bob');
  197.   reset(PageFile);
  198.   if IOResult = 0 then
  199.   begin
  200.     while not eof(PageFile) do
  201.     begin
  202.       readln(PageFile,Titles[WebPages]);
  203.       Inc(WebPages)
  204.     end;
  205.     close(PageFile)
  206.   end;
  207.   WebPages := 0;
  208.   assign(PageFile,'pages.bob');
  209.   reset(PageFile);
  210.   if IOResult = 0 then
  211.   begin
  212.     while not eof(PageFile) do
  213.     begin
  214.       readln(PageFile,WebPage[WebPages]);
  215.       Inc(WebPages)
  216.     end;
  217.     close(PageFile)
  218.   end;
  219. {$IFDEF BLOCK}
  220.   Dec(WebPages);
  221.   total := StrToInt(WebPage[WebPages]);
  222. {$ENDIF}
  223.   assign(IndexFile,'index.bob');
  224. {$IFDEF BLOCK}
  225.   reset(IndexFile,1);
  226. {$ELSE}
  227.   reset(IndexFile);
  228.   total := FileSize(IndexFile);
  229. {$ENDIF}
  230.   if IOResult = 0 then
  231.   begin
  232.     if total = 1 then root := TTree.Create
  233.     else {total > 1}
  234.     begin
  235.       depth := 0;
  236.       i := 1;
  237.       repeat
  238.         i := i SHL 1;
  239.         Inc(depth)
  240.       until i >= total;
  241.       Dec(depth);
  242.       i := total - (i SHR 1) + 1;
  243.       root := CreateRoot(depth);
  244.       if i > 0 then CreateLeafs(i, root)
  245.     end;
  246.     if total > 0 then
  247.       ReadNode(IndexFile, root);
  248.     close(IndexFile)
  249.   end
  250. finalization
  251.   writeln('<HR>');
  252.   writeln('<FONT SIZE=1>');
  253.   writeln('Webpages: ',WebPages);
  254.   writeln('<BR>Keywords: ',Keywords);
  255.   writeln('<BR>Search Time: ',timeGetTime-StartTime,' msec.');
  256.   writeln('</FONT>');
  257.   writeln('<HR>');
  258.   writeln('</BODY>');
  259.   writeln('</HTML>');
  260.   root.Free
  261. end.
  262.